home *** CD-ROM | disk | FTP | other *** search
/ Suzy B Software 2 / Suzy B Software CD-ROM 2 (1994).iso / nasa / moon / moon.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-05-02  |  3.8 KB  |  125 lines
  1. program moon; { Mondpositionen berechnen }
  2.  
  3. const
  4.    {$I b:math_con }
  5.  
  6. type
  7.    DATUM = record
  8.               jahr:integer;
  9.               monat:1..12;
  10.               tag:1..31;
  11.            end;
  12.  
  13.    ZEIT = record
  14.              stunde:0..23;
  15.              minute,sekunde:0..59;
  16.           end;
  17.  
  18.    JUL = record
  19.             ganz:long_integer;
  20.             fract:real;
  21.          end;
  22.  
  23. var start,stop:JUL;
  24.     date:DATUM;
  25.     lokal:ZEIT;
  26.     ra,de,r,f,f1:real;
  27.     i,increment,h,h1,h2:integer;
  28.     printer:boolean;
  29.     c:char;
  30.  
  31.    {$I b:math_sub }
  32.  
  33. procedure juldat (var julian:JUL; gregorian:DATUM; uhrzeit:ZEIT;
  34.                   flag:boolean);
  35. external;
  36.  
  37. procedure gregdat(var gregorian:DATUM; var uhrzeit:ZEIT; julian:JUL;
  38.                   flag:boolean);
  39. external;
  40.  
  41. procedure lun_pos (var ra,de,r:real; julian:JUL);
  42. external;
  43.  
  44. procedure par_ein(var start,stop:JUL; var incr:integer; var printer:boolean);
  45. var lokal:ZEIT;
  46.     date:DATUM;
  47.     greg:boolean;
  48.     c:char;
  49.     t:real;
  50. begin
  51.    writeln(chr(27),'E< CALCULATE LUNAR POSITION >');
  52.    writeln;
  53.    writeln('  Enter parameters:');
  54.    write('> Enter start: year : '); readln(date.jahr);
  55.    write('>              month: '); readln(date.monat);
  56.    write('>              day  : '); readln(date.tag);
  57.    write('>              gregorian calendar (y/n): '); read(c);
  58.    writeln;
  59.    if c = 'n' then greg := false else greg := true;
  60.    lokal.stunde := 0; lokal.minute := 0; lokal.sekunde := 0;
  61.    juldat(start,date,lokal,greg);
  62.    write('> Enter stop : year : '); readln(date.jahr);
  63.    write('>              month: '); readln(date.monat);
  64.    write('>              day  : '); readln(date.tag);
  65.    write('>              gregorian calendar (y/n): '); read(c);
  66.    writeln;
  67.    if c = 'n' then greg := false else greg := true;
  68.    juldat(stop,date,lokal,greg);
  69.    write('> Enter UT   : hour  : '); readln(lokal.stunde);
  70.    write('>              minute: '); readln(lokal.minute);
  71.    write('>              second: '); readln(lokal.sekunde);
  72.    t := (lokal.stunde * 3600.0 + lokal.minute * 60.0 + lokal.sekunde) /
  73.         86400.0;
  74.    start.fract := start.fract + t;
  75.    stop.fract := stop.fract + t;
  76.    if start.fract < 0.0 then
  77.    begin
  78.       start.fract := start.fract + 1.0; start.ganz := start.ganz - 1;
  79.       stop.fract := stop.fract + 1.0; stop.ganz := stop.ganz - 1
  80.    end;
  81.    writeln;
  82.    write('> Enter increment: '); readln(incr);
  83.    writeln;
  84.    write('> Output to screen or printer (s/p): '); read(c);
  85.    if c = 'p' then printer := true else printer := false;
  86. end;
  87.  
  88. begin
  89.    par_ein(start,stop,increment,printer);
  90.    gregdat(date,lokal,start,true); i := 0;
  91.    if printer then rewrite(output,'LST:');
  92.    while start.ganz <= stop.ganz do
  93.    begin
  94.       if i = 0 then
  95.       begin
  96.          if not printer then write(chr(27),'E');
  97.          writeln('       Lunar positions of at ',lokal.stunde:2,'h',
  98.          lokal.minute:2,'m',lokal.sekunde:2,'s UT for equinoxe 1950.0');
  99.          writeln;
  100.          writeln('          Date        RA         De         r/Erdradien');
  101.          writeln('       ------------------------------------------------')
  102.       end;
  103.       lun_pos(ra,de,r,start);
  104.       ra := deg(ra) / 15.0; de := deg(de);
  105.       h := trunc(ra); f := (ra - h) * 60;
  106.       h2 := sign(de); de := abs(de); h1 := h2 * trunc(de);
  107.       f1 := (de - abs(h1)) * 60.0;
  108.       gregdat(date,lokal,start,true);
  109.       write('       ');
  110.       writeln(date.jahr:4,date.monat:3,date.tag:3,'  ',h:3,f:5:1,'   ',
  111.               h1:3,f1:5:1,'   ',r:7:4);
  112.       i := i + 1;
  113.       start.ganz := start.ganz + increment;
  114.       if not printer then
  115.          if i = 15 then
  116.          begin
  117.             writeln; writeln('                     PRESS ANY KEY TO CONTINUE');
  118.             read(c);
  119.             i := 0
  120.          end
  121.    end;
  122.    read(c)
  123. end.
  124.  
  125.